home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / mswlogo3.zip / MSWLOGO.ZIP / EXAMPLES.ZIP / PLAYFAIR < prev    next >
Text File  |  1993-04-12  |  3KB  |  118 lines
  1. ;
  2. ; Function:
  3. ;
  4. ; Encryption program (seems buggy?)
  5. ;
  6. ; To run:
  7. ;
  8. ; Load "playfair
  9. ; Call PLAYFAIR "key "message
  10. ; Outputs encryted message
  11. ;
  12. ; Example:
  13. ;
  14. ; make "mes PLAYFAIR "xyz "HELLO
  15. ; print :mes
  16. ; print PLAYFAIR "xyz :mes
  17. ;
  18. TO BIGWORD :LIST
  19. IF EMPTYP :LIST [OUTPUT "]
  20. OUTPUT WORD FIRST :LIST BIGWORD BF :LIST
  21. END
  22.  
  23. TO ENCODE :MESSAGE
  24. IF EMPTYP :MESSAGE [OUTPUT "]
  25. IF EMPTYP BF :MESSAGE [OUTPUT PAIRCODE FIRST :MESSAGE "Q]
  26. IF EQUALP (JTOI FIRST :MESSAGE) (JTOI FIRST BF :MESSAGE) ~
  27.    [OUTPUT WORD (PAIRCODE FIRST :MESSAGE "Q) (ENCODE BF :MESSAGE)]
  28. OUTPUT WORD (PAIRCODE FIRST :MESSAGE FIRST BF :MESSAGE) ~
  29.             (ENCODE BF BF :MESSAGE)
  30. END
  31.  
  32. TO ITOJ :LETTER
  33. IF EQUALP :LETTER "I [IF EQUALP RANDOM 3 0 [OUTPUT "J]]
  34. OUTPUT :LETTER
  35. END
  36.  
  37. TO JTOI :WORD
  38. IF EMPTYP :WORD [OUTPUT "]
  39. IF EQUALP FIRST :WORD "J [OUTPUT WORD "I JTOI BF :WORD]
  40. OUTPUT WORD FIRST :WORD JTOI BF :WORD
  41. END
  42.  
  43. TO LETTER :COORDS
  44. OUTPUT ITOJ ITEM LAST :COORDS (ITEM FIRST :COORDS :MATRIX)
  45. END
  46.  
  47. TO LETTERS :ONE :TWO
  48. OUTPUT WORD LETTER :ONE LETTER :TWO
  49. END
  50.  
  51. TO PAIRCODE :ONE :TWO
  52. OUTPUT PAIRCODE1 (THING :ONE) (THING :TWO)
  53. END
  54.  
  55. TO PAIRCODE1 :ONE :TWO
  56. LOCAL [A B C D]
  57. MAKE "A FIRST :ONE
  58. MAKE "B LAST :ONE
  59. MAKE "C FIRST :TWO
  60. MAKE "D LAST :TWO
  61. IF EQUALP :A :C ~
  62.    [OUTPUT LETTERS (LIST :A ROTATE (:B+1)) ~
  63.                    (LIST :A ROTATE (:D+1))]
  64. IF EQUALP :B :D ~
  65.    [OUTPUT LETTERS (LIST ROTATE (:A+1) :B)  ~
  66.                    (LIST ROTATE (:C+1) :B)]
  67. OUTPUT LETTERS (LIST :A :D) (LIST :C :B)
  68. END
  69.  
  70. TO PLAYFAIR :KEYWORD :MESSAGE
  71. SETKEYWORD JTOI :KEYWORD
  72. OUTPUT ENCODE BIGWORD :MESSAGE
  73. END
  74.  
  75. TO REMOVE :LETTERS :STRING
  76. IF EMPTYP :STRING [OUTPUT "]
  77. IF MEMBERP FIRST :STRING :LETTERS [OUTPUT REMOVE :LETTERS BF :STRING]
  78. OUTPUT WORD FIRST :STRING REMOVE :LETTERS BF :STRING
  79. END
  80.  
  81. TO REORDER :STRING
  82. OUTPUT REORDER1 :STRING [] [] 5
  83. END
  84.  
  85. TO REORDER1 :STRING :ALL :ROW :COUNT
  86. IF EQUALP :COUNT 0 [OUTPUT REORDER1 :STRING (LPUT :ROW :ALL) [] 5]
  87. IF EMPTYP :STRING [OUTPUT :ALL]
  88. OUTPUT REORDER1 (BF :STRING) :ALL (LPUT FIRST :STRING :ROW) ~
  89.                 (:COUNT-1)
  90. END
  91.  
  92. TO ROTATE :INDEX
  93. OUTPUT IFELSE EQUALP :INDEX 6 [1] [:INDEX]
  94. END
  95.  
  96. TO SETKEYWORD :WORD
  97. MAKE "MATRIX REORDER WORD :WORD REMOVE :WORD "ABCDEFGHIKLMNOPQRSTUVWXYZ
  98. SETLETTERS :MATRIX
  99. MAKE "J :I
  100. END
  101.  
  102. TO SETLETTERS :MATRIX
  103. SETLETTERS1 :MATRIX 1
  104. END
  105.  
  106. TO SETLETTERS1 :MATRIX :ROW
  107. IF EMPTYP :MATRIX [STOP]
  108. SETLETTERS2 (FIRST :MATRIX) :ROW 1
  109. SETLETTERS1 (BF :MATRIX) (:ROW+1)
  110. END
  111.  
  112. TO SETLETTERS2 :LIST :ROW :COL
  113. IF EMPTYP :LIST [STOP]
  114. MAKE FIRST :LIST LIST :ROW :COL
  115. SETLETTERS2 (BF :LIST) :ROW (:COL+1)
  116. END
  117.  
  118.